home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / metamail.el.z / metamail.el
Encoding:
Text File  |  1998-05-21  |  8.1 KB  |  227 lines
  1. ;;; metamail.el --- Metamail interface for GNU Emacs
  2.  
  3. ;; Copyright (C) 1993, 1996  Masanobu UMEDA
  4.  
  5. ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
  6. ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/metamail.el,v 1.5 1996/04/19 18:05:38 rms Exp $
  7. ;; Keywords: mail, news, mime, multimedia
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.34.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; I trashed all the differences this file had from the FSF version.
  31. ;;  So sue me.  -sb
  32.  
  33. ;; The latest version will be at:
  34. ;;    ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
  35.  
  36. ;; Note: Metamail does not have all options which is compatible with
  37. ;; the environment variables.  For that reason, matamail.el have to
  38. ;; hack the environment variables.  In addition, there is no way to
  39. ;; display all header fields without extra informative body messages
  40. ;; which are suppressed by "-q" option.
  41.  
  42. ;; The following definition is what I'm using with GNUS 4:
  43. ;;(setq gnus-show-mime-method
  44. ;;      (function
  45. ;;       (lambda ()
  46. ;;        (metamail-interpret-header)
  47. ;;        (let ((metamail-switches     ;Suppress header fields in a body.
  48. ;;               (append metamail-switches '("-q"))))
  49. ;;          (metamail-interpret-body)))))
  50.  
  51. ;; The idea of using metamail to process MIME messages is from
  52. ;; gnus-mime.el by Spike <Spike@world.std.com>.
  53.  
  54. ;;; Code:
  55.  
  56. (defgroup metamail nil
  57.   "Metamail interface for Emacs."
  58.   :group 'mail
  59.   :group 'hypermedia
  60.   :group 'processes)
  61.  
  62. (defcustom metamail-program-name "metamail"
  63.   "*Metamail program name."
  64.   :type 'string
  65.   :group 'metamail)
  66.  
  67. (defcustom metamail-mailer-name "emacs"
  68.   "*Mailer name set to MM_MAILER environment variable."
  69.   :type 'string
  70.   :group 'metamail)
  71.  
  72. (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
  73.   "*Environment variables passed to `metamail'.
  74. It must be a list of strings that have the format ENVVARNAME=VALUE.
  75. It is not expected to be altered globally by `set' or `setq'.
  76. Instead, change its value temporary using `let' or `let*' form.")
  77.  
  78. (defcustom metamail-switches '("-x" "-d" "-z")
  79.   "*Switches for `metamail' program.
  80. `-z' is required to remove zap file.
  81. It is not expected to be altered globally by `set' or `setq'.
  82. Instead, change its value temporary using `let' or `let*' form.
  83. `-m MAILER' argument is automatically generated from the
  84. `metamail-mailer-name' variable."
  85.   :type '(repeat (string :tag "Switch"))
  86.   :group 'metamail)
  87.  
  88. ;;;###autoload
  89. (defun metamail-interpret-header ()
  90.   "Interpret a header part of a MIME message in current buffer.
  91. Its body part is not interpreted at all."
  92.   (interactive)
  93.   (save-excursion
  94.     (let* ((buffer-read-only nil)
  95.        (metamail-switches           ;Inhibit processing an empty body.
  96.         (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
  97.        (end (progn
  98.           (goto-char (point-min))
  99.           (search-forward "\n\n" nil 'move)
  100.           ;; An extra newline is inserted by metamail if there
  101.           ;; is no body part.  So, insert a dummy body by
  102.           ;; itself.
  103.           (insert "\n")
  104.           (point))))
  105.       (metamail-region (point-min) end nil nil 'nodisplay)
  106.       ;; Remove an extra newline inserted by myself.
  107.       (goto-char (point-min))
  108.       (if (search-forward "\n\n\n" nil t)
  109.       (delete-char -1))
  110.       )))
  111.  
  112. ;;;###autoload
  113. (defun metamail-interpret-body (&optional viewmode nodisplay)
  114.   "Interpret a body part of a MIME message in current buffer.
  115. Optional argument VIEWMODE specifies the value of the
  116. EMACS_VIEW_MODE environment variable (defaulted to 1).
  117. Optional argument NODISPLAY non-nil means buffer is not
  118. redisplayed as output is inserted.
  119. Its header part is not interpreted at all."
  120.   (interactive "p")
  121.   (save-excursion
  122.     (let ((contype nil)
  123.       (encoding nil)
  124.          (end (progn
  125.                 (goto-char (point-min))
  126.                 (search-forward "\n\n" nil t)
  127.                 (point))))
  128.       ;; Find Content-Type and Content-Transfer-Encoding from the header.
  129.       (save-restriction
  130.     (narrow-to-region (point-min) end)
  131.     (setq contype 
  132.           (or (mail-fetch-field "Content-Type") "text/plain"))
  133.     (setq encoding 
  134.           (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
  135.       ;; Interpret the body part only.
  136.       (let ((metamail-switches         ;Process body part only.
  137.          (append metamail-switches
  138.              (list "-b" "-c" contype "-E" encoding))))
  139.     (metamail-region end (point-max) viewmode nil nodisplay))
  140.       ;; Mode specific hack.
  141.       (cond ((eq major-mode 'rmail-mode)
  142.          ;; Adjust the marker of this message if in Rmail mode buffer.
  143.          (set-marker (aref rmail-message-vector (1+ rmail-current-message))
  144.              (point-max))))
  145.       )))
  146.  
  147. ;;;###autoload
  148. (defun metamail-buffer (&optional viewmode buffer nodisplay)
  149.   "Process current buffer through `metamail'.
  150. Optional argument VIEWMODE specifies the value of the
  151. EMACS_VIEW_MODE environment variable (defaulted to 1).
  152. Optional argument BUFFER specifies a buffer to be filled (nil
  153. means current).
  154. Optional argument NODISPLAY non-nil means buffer is not
  155. redisplayed as output is inserted."
  156.   (interactive "p")
  157.   (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
  158.  
  159. ;;;###autoload
  160. (defun metamail-region (beg end &optional viewmode buffer nodisplay)
  161.   "Process current region through 'metamail'.
  162. Optional argument VIEWMODE specifies the value of the
  163. EMACS_VIEW_MODE environment variable (defaulted to 1).
  164. Optional argument BUFFER specifies a buffer to be filled (nil
  165. means current).
  166. Optional argument NODISPLAY non-nil means buffer is not
  167. redisplayed as output is inserted."
  168.   (interactive "r\np")
  169.   (let ((curbuf (current-buffer))
  170.     (buffer-read-only nil)
  171.     (metafile (make-temp-name "/tmp/metamail"))
  172.     (option-environment
  173.      (list (concat "EMACS_VIEW_MODE=" 
  174.                (if (numberp viewmode) viewmode 1)))))
  175.     (save-excursion
  176.       ;; Gee!  Metamail does not ouput to stdout if input comes from
  177.       ;; stdin.
  178.       (let ((selective-display nil)  ;Disable ^M to nl translation.
  179.         (kanji-fileio-code 2)    ;Write in JIS code when nemacs.
  180.         (file-coding-system      ;Write in JUNET style when mule.
  181.          (if (featurep 'mule) '*junet*))
  182.         (coding-system-for-write ;Write in iso-2022-jp style
  183.          'iso-2022-jp)           ;    when XEmacs/mule
  184.         )
  185.     (write-region beg end metafile nil 'nomessage))
  186.       (if buffer
  187.       (set-buffer buffer))
  188.       (setq buffer-read-only nil)
  189.       ;; Clear destination buffer.
  190.       (if (eq curbuf (current-buffer))
  191.       (delete-region beg end)
  192.     (delete-region (point-min) (point-max)))
  193.       ;; We have to pass the environment variable KEYHEADS to display
  194.       ;; all header fields.  Metamail should have an optional argument
  195.       ;; to pass such information directly.
  196.       (let ((process-environment
  197.          (append process-environment
  198.              metamail-environment option-environment)))
  199.     ;; Specify character coding system.
  200.     (if (boundp 'NEMACS)
  201.         (define-program-kanji-code nil metamail-program-name 2)) ;JIS
  202.     (if (featurep 'mule)
  203.         (if (fboundp 'define-program-coding-system)
  204.         (define-program-coding-system
  205.           nil
  206.           metamail-program-name
  207.           'junet)
  208.           ;; XEmacs with MULE
  209.           (setq buffer-file-coding-system 'junet)))
  210.     (apply (function call-process)
  211.            metamail-program-name
  212.            nil
  213.            t                        ;Output to current buffer
  214.            (not nodisplay)          ;Force redisplay
  215.            (append metamail-switches
  216.                (list "-m" (or metamail-mailer-name "emacs"))
  217.                (list metafile))))
  218.       ;; `metamail' may not delete the temporary file!
  219.       (condition-case error
  220.       (delete-file metafile)
  221.     (error nil))
  222.       )))
  223.  
  224. (provide 'metamail)
  225.  
  226. ;;; metamail.el ends here
  227.